/* REXX _death_reporter.zrx by the reverend (build 44)                        */
/*-       built by rev-builder version 1.1 on 13 Nov 2002 at 16:54:54        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  this script works within TEDIT to report the number of       */
/*               deaths suffered by each player. you have the option to       */
/*               produce html output that is sorted by username without the   */
/*               TEDIT user numbers in the list. this will prevent players    */
/*               from gaining an unfair advantage at the attack prompt.       */
/* rev. 0 - initial release                                                   */

call zoctimeout 60
call zocsynctime 1500
globals="globals"
call on halt name _halt

if \_pcheck("Trade Wars 2002 Editor (?=Help) [?] :") then call _error "please start at the TEDIT main prompt."

call zocsend "gq"
if zocwait("Max # of players: ")=640 then call _error "timeout"
if zocwait(", sectors:")=640 then call _error "timeout"
parse value _lastline() with max ", sectors:"
if zocwait("Trade Wars 2002 Editor (?=Help) [?] :")=640 then call _error "timeout"

deaths.=-1
playername.=""
bbsname.=""
corp.=0
do i=1 to max
 ans=99
 if i=1 then call zocsend "u1^M"
 else call zocsend ">"
 do while ans>0
  ans=zocwaitmux("User edit: (?) (<>) (X=Exit) [X] :", ,
                 "<A> Name           : ", ,
                 "<B> BBS Name       : ", ,
                 "<M> Times Blown Up : ", ,
                 "<J> Member of Corp : ")
  select
   when ans=0 then nop
   when ans=1 then do
    if zocwait("^M")=640 then call _error "timeout"
    parse value _lastline() with playername.i "(#" .
   end /*when*/
   when ans=2 then do
    if zocwait("^M")=640 then call _error "timeout"
    bbsname.i=_lastline()
   end /*when*/
   when ans=3 then do
    if zocwait("^M")=640 then call _error "timeout"
    deaths.i=_lastline()
   end /*when*/
   when ans=4 then do
    if zocwait("^M")=640 then call _error "timeout"
    corp.i=_lastline()
   end /*when*/
   when ans=640 then call _error "timeout"
   otherwise nop
  end /*select*/
 end /*do*/
end /*do*/

call zocsend "x"
if zocwait("Trade Wars 2002 Editor (?=Help) [?] :")=640 then call _error "timeout"
call _newline _ansi("bt;fwh")

do i=1 to max
 select
  when deaths.i>=0 then call zocwriteln i||" "||playername.i||copies(" ",20-length(playername.i))||" "||deaths.i
  when bbsname.i\="" then call zocwriteln i||" "||bbsname.i||copies(" ",20-length(bbsname.i))||" inactive"
  otherwise nop
 end /*select*/
end /*do*/

if _yesno("html output?") then do
 j=0
 do i=1 to max
  j=j+1
  select
   when deaths.i>=0 then line.j="<td>"||copies("0",2-length(corp.i))||corp.i||"</td><td>"||playername.i||"</td><td>"||deaths.i||" deaths</td></tr>"
   when bbsname.i\="" then line.j="<td>"||copies("0",2-length(corp.i))||corp.i||"</td><td>"||bbsname.i||"</td><td>"||"inactive"||"</td></tr>"
   otherwise j=j-1
  end /*select*/
 end /*do*/
 line.0=j
 do i=1 to line.0
  do j=i to line.0
   if lower(line.i)>lower(line.j) then do
    temp=line.i
    line.i=line.j
    line.j=temp
   end /*if*/
  end /*do*/
 end /*do*/
 call zocwriteln "<table border="1" cellspacing="0" cellpadding="4">"
 call zocwriteln "<tr><td>corp</td><td>playername</td><td>status</td></tr>"
 do i=1 to line.0
  call zocwriteln line.i
 end /*do*/
 call zocwriteln "</table>"
end /*if*/
exit

/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt